01b_Squirrel_activity_Env_data_raster_correlation.knit

Setup

Data

### read all environmental raster data ----

files<-dir(here::here("data-raw",
                "geo-raw",
                "all_environmental_rasters_10m_3035"),pattern = "*.tif")

raster_stack <- files %>%
  map(~raster(file.path(here::here("data-raw",
                "geo-raw",
                "all_environmental_rasters_10m_3035"), .)))%>%
  stack()

names(raster_stack)
 [1] "distance_to_border_3035"                              
 [2] "distance_to_open_green_areas_raster_2020_10m_3035"    
 [3] "distance_to_streets_berlin_raster_10m_2015_3035"      
 [4] "green_capacity_berlin_raster_10m_2010_3035"           
 [5] "human_population_density_raster_10m_2017_3035"        
 [6] "imperviousness_berlin_copernicus_raster_10m_2018_3035"
 [7] "summer_temperature_berlin_04h_2016_3035"              
 [8] "summer_temperature_berlin_14h_2016_3035"              
 [9] "supply_green_areas_berlin_raster_10m_2016_3035"       
[10] "traffic_volume_berlin_raster_10m_2014_3035"           
# create own function, focal analysis can't be applied on raster stack / brick simulatenously ----

multiFocal <- function(x, w=matrix(1, nr=11, nc=11), ...) {

   if(is.character(x)) {
     x <- brick(x)
   }
   # The function to be applied to each individual layer
   fun <- function(ind, x, w, ...){
     focal(x[[ind]], w=w, ...)
   }

   n <- seq(nlayers(x))
   list <- lapply(X=n, FUN=fun, x=x, w=w, ...)

   out <- stack(list)
   return(out)
}

################################################################################

# Apply focal mean on all raster layers ----

 
focal_mean_stack<-raster_stack%>%
  multiFocal()

names(focal_mean_stack)<-names(raster_stack)

plot(focal_mean_stack,colna="red")

ct_locations<-readRDS(here("output",
                           "data-proc",
                           "all_seasons",
                           "stacked_raster_values_and_garden_CT_all_seasons_no_nas_proc_20221117.RDS"))

ct_spatial<-st_as_sf(ct_locations,coords = c("Long","Lat"),remove=F,crs=32633) %>%
  st_transform(crs = 3035)

#### extract covariates ----

cov<-terra::extract(focal_mean_stack,ct_spatial)%>%
  data.frame()

#### bind

ct_cov<-cbind(ct_locations,cov)

saveRDS(ct_cov,here("output",
                    "data-proc",
                    "all_seasons",
                    "ct_focal_covariates_100.RDS"))
cor<-cor(cov, use = "complete.obs")%>%
  data.frame()%>%
  as.matrix()

melted_cor<-reshape2::melt(cor)

ggplot(data = melted_cor, aes(x=Var2, y=forcats::fct_rev(Var1), fill=value)) +
  geom_tile() +
  geom_text(aes(
    label = format(round(value, 2), nsmall = 2),
    color = abs(value) < .75
  )) +
  coord_fixed(expand = F) +
  scale_color_manual(values = c("white", "black"),
                     guide = "none") +
  scale_fill_distiller(
    palette = "RdBu", na.value = "white",
    direction = 1, limits = c(-1, 1)
  ) +
  labs(x = NULL, y = NULL) + scale_x_discrete(position = "top")+
  theme(panel.border = element_rect(color = NA, fill = NA),
        axis.text.x = element_text(angle = 45, hjust=0,size = 15),
        axis.text.y = element_text(size = 15),
        legend.key.size = unit(1.2,"cm"),
        legend.text = element_text(size = 15),
        legend.title = element_text(size = 20))

cor<-as.data.frame(layerStats(raster_stack,stat="pearson",na.rm = T))
colnames(cor)<-rownames(cor)
cor<-as.matrix(cor[,1:10])
cor[cor>=1]=1;cor[upper.tri(cor)]<-NA

melted_cor<-reshape2::melt(cor)

ggplot(data = melted_cor, aes(x=Var2, y=Var1, fill=value)) +
  geom_tile() +
  geom_text(aes(
    label = format(round(value, 2), nsmall = 2),
    color = abs(value) < .75
  )) +
  coord_fixed(expand = FALSE) +
  scale_color_manual(values = c("white", "black"),
                     guide = "none") +
  scale_fill_distiller(
    palette = "RdBu", na.value = "white",
    direction = 1, limits = c(-1, 1)
  ) +
  labs(x = NULL, y = NULL) + scale_x_discrete(position = "top")+
  theme(panel.border = element_rect(color = NA, fill = NA),
        legend.position = c(.95, .4),
        axis.text.x = element_text(angle = 45, hjust=0,size = 15),
        axis.text.y = element_text(size = 15),
        legend.key.size = unit(1.2,"cm"),
        legend.text = element_text(size = 15),
        legend.title = element_text(size = 20))

#ggsave(here("plots","raster_correlation.png"),width = 12, height = 9)

Session Info
## DO NOT REMOVE!
## We store the settings of your computer and the current versions of the
## packages used to allow for reproducibility
Sys.time()
[1] "2022-11-20 17:42:19 CET"
#git2r::repository() ## uncomment if you are using GitHub
sessionInfo()
R version 4.2.1 (2022-06-23 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 17763)

Matrix products: default

locale:
[1] LC_COLLATE=German_Germany.1252  LC_CTYPE=German_Germany.1252   
[3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C                   
[5] LC_TIME=C                      

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
 [1] sf_1.0-8        here_1.0.1      raster_3.6-3    sp_1.5-0       
 [5] forcats_0.5.2   stringr_1.4.1   dplyr_1.0.10    purrr_0.3.4    
 [9] readr_2.1.3     tidyr_1.2.1     tibble_3.1.8    ggplot2_3.3.6  
[13] tidyverse_1.3.2

loaded via a namespace (and not attached):
 [1] fs_1.5.2            lubridate_1.8.0     RColorBrewer_1.1-3 
 [4] httr_1.4.4          rprojroot_2.0.3     tools_4.2.1        
 [7] backports_1.4.1     bslib_0.4.0         rgdal_1.5-32       
[10] utf8_1.2.2          R6_2.5.1            KernSmooth_2.23-20 
[13] DBI_1.1.3           colorspace_2.0-3    withr_2.5.0        
[16] tidyselect_1.1.2    downlit_0.4.2       compiler_4.2.1     
[19] textshaping_0.3.6   cli_3.4.1           rvest_1.0.3        
[22] xml2_1.3.3          labeling_0.4.2      sass_0.4.2         
[25] scales_1.2.1        classInt_0.4-8      proxy_0.4-27       
[28] systemfonts_1.0.4   digest_0.6.29       rmarkdown_2.16     
[31] pkgconfig_2.0.3     htmltools_0.5.3     highr_0.9          
[34] dbplyr_2.2.1        fastmap_1.1.0       rlang_1.0.6        
[37] readxl_1.4.1        rstudioapi_0.14     farver_2.1.1       
[40] jquerylib_0.1.4     generics_0.1.3      jsonlite_1.8.2     
[43] distill_1.5         googlesheets4_1.0.1 magrittr_2.0.3     
[46] Rcpp_1.0.9          munsell_0.5.0       fansi_1.0.3        
[49] lifecycle_1.0.3     terra_1.6-17        stringi_1.7.8      
[52] yaml_2.3.5          plyr_1.8.7          grid_4.2.1         
[55] crayon_1.5.2        lattice_0.20-45     haven_2.5.1        
[58] hms_1.1.2           knitr_1.40          pillar_1.8.1       
[61] reshape2_1.4.4      codetools_0.2-18    reprex_2.0.2       
[64] glue_1.6.2          evaluate_0.16       modelr_0.1.9       
[67] vctrs_0.4.2         tzdb_0.3.0          cellranger_1.1.0   
[70] gtable_0.3.1        assertthat_0.2.1    cachem_1.0.6       
[73] xfun_0.33           broom_1.0.1         e1071_1.7-11       
[76] ragg_1.2.3          class_7.3-20        googledrive_2.0.0  
[79] gargle_1.2.1        memoise_2.0.1       units_0.8-0        
[82] ellipsis_0.3.2